home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / FILEBASE.I < prev    next >
Encoding:
Modula Implementation  |  1990-05-12  |  5.4 KB  |  241 lines
  1. IMPLEMENTATION MODULE FileBase;
  2. (*$Y+,M-,R-*)
  3.  
  4. (* V#0027 *)
  5.  
  6. (* !!! die flush-funktionen für v24, midi, printer, usw. müssen warten,
  7.  * bis der ausgabepuffer geleert ist !
  8.  *
  9.  * 14.03.88: MOVE.L InOutErr,... --> MOVE.L #InOutErr,...
  10.  * 05.06.88: Die Treibervariablen f. InOut befinden sich nun im Modul
  11.  *           'InOutBase'.
  12.  * 28.01.89: chin meldet nie Fehler -> Text.Read (MIDI) geht jetzt?
  13.  * 07.09.89: MIDI-Handle von 3 auf 4 korrigiert
  14.  * 23.03.90: strout lädt Regs korrekt zurück (führte bei nicht-vollen Strings
  15.  *           zu Bus-Errors)
  16.  * 12.05.90: strout und dout prüfen timeout bei Printer (handle = 0) und
  17.  *           liefern dann -1 als Error-Code
  18.  *)
  19.  
  20. FROM SYSTEM IMPORT ASSEMBLER, LONGWORD, ADDRESS, CAST;
  21.  
  22. FROM SysTypes IMPORT ScanDesc;
  23.  
  24.  
  25. PROCEDURE dummyClose (f:File0; new:BOOLEAN);
  26.   END dummyClose;
  27.  
  28. PROCEDURE dummyHdlErr ( VAR f:File0; err:INTEGER; info: ScanDesc );
  29.   BEGIN
  30.     (* Fehler ignorieren *)
  31.   END dummyHdlErr;
  32.  
  33. PROCEDURE open0 (VAR hdl:LONGWORD; name: ARRAY OF CHAR): INTEGER;
  34.   BEGIN
  35.     RETURN 0
  36.   END open0;
  37.  
  38. PROCEDURE close0 (hdl:LONGWORD): INTEGER;
  39.   BEGIN
  40.     RETURN 0
  41.   END close0;
  42.  
  43.  
  44. PROCEDURE din ( hdl: LONGWORD; ad:ADDRESS; VAR l:LONGCARD ): INTEGER;
  45.   (*$L-*)
  46.   BEGIN
  47.     ASSEMBLER
  48.         MOVEM.L D4/D5/A4,-(A7)
  49.         MOVE.L  -(A3),A0
  50.         MOVE.L  (A0),D4
  51.         MOVE.L  -(A3),A4
  52.         MOVE.L  -(A3),D5
  53.         BRA     st
  54.        lo:
  55.         MOVE    D5,-(A7)
  56.         MOVE    #2,-(A7)
  57.         TRAP    #13
  58.         ADDQ.L  #4,A7
  59.         MOVE.B  D0,(A4)+
  60.        st:
  61.         DBRA    D4,lo
  62.         MOVEM.L (A7)+,D4/D5/A4
  63.         CLR     (A3)+
  64.     END
  65.   END din;
  66.   (*$L=*)
  67.  
  68. PROCEDURE chin ( hdl: LONGWORD ): INTEGER;
  69.   (*$L-*)
  70.   BEGIN
  71.     ASSEMBLER
  72.         MOVE.L  -(A3),D5
  73.         MOVE    D5,-(A7)
  74.         MOVE    #2,-(A7)
  75.         TRAP    #13
  76.         ADDQ.L  #4,A7
  77.         ANDI.W  #$00FF,D0       ; tja, da meldet das BIOS sowieso nie Fehler
  78.         MOVE.W  D0,(A3)+        ; und bei MIDI ist das upper Byte immer $FF !
  79.     END
  80.   END chin;
  81.   (*$L=*)
  82.  
  83. PROCEDURE dout ( hdl: LONGWORD; ad:ADDRESS; VAR l:LONGCARD ): INTEGER;
  84.   (*$L-*)
  85.   BEGIN
  86.     ASSEMBLER
  87.         MOVEM.L D4/D5/A4/A6,-(A7)
  88.         MOVE.L  -(A3),A6
  89.         MOVE.L  (A6),D4
  90.         CLR.L   (A6)
  91.         MOVE.L  -(A3),A4
  92.         MOVE.L  -(A3),D5        ; hdl
  93.         MOVEQ   #1,D0
  94.         BRA     st
  95.        lo:
  96.         MOVE.B  (A4)+,D0
  97.         MOVE    D0,-(A7)
  98.         MOVE    D5,-(A7)
  99.         MOVE    #3,-(A7)
  100.         TRAP    #13
  101.         ADDQ.L  #6,A7
  102.         TST.L   D0
  103.         OR.L    D5,D0           ; nur bei Printer den Return-Wert prüfen
  104.         BEQ     error
  105.         ADDQ.L  #1,(A6)
  106.        st:
  107.         DBRA    D4,lo
  108.        ok:
  109.         MOVEM.L (A7)+,D4/D5/A4/A6
  110.         CLR     (A3)+
  111.         RTS
  112.        error:
  113.         ; Printer-Timeout
  114.         MOVEM.L (A7)+,D4/D5/A4/A6
  115.         MOVE    #-1,(A3)+
  116.     END
  117.   END dout;
  118.   (*$L=*)
  119.  
  120. PROCEDURE strout ( hdl: LONGWORD; REF str: ARRAY OF CHAR ): INTEGER;
  121.   (*$L-*)
  122.   BEGIN
  123.     ASSEMBLER
  124.         MOVEM.L D4/D5/A4,-(A7)
  125.         MOVE.W  -(A3),D4
  126.         MOVE.L  -(A3),A4
  127.         MOVE.L  -(A3),D5
  128.         MOVEQ   #0,D0
  129.        lo:
  130.         MOVE.B  (A4)+,D0
  131.         BEQ     ok
  132.         MOVE    D0,-(A7)
  133.         MOVE    D5,-(A7)
  134.         MOVE    #3,-(A7)
  135.         TRAP    #13
  136.         ADDQ.L  #6,A7
  137.         
  138.         TST.L   D0
  139.         OR.L    D5,D0           ; nur bei Printer den Return-Wert prüfen
  140.        st:
  141.         DBEQ    D4,lo
  142.         BNE     ok
  143.         ; Printer-Timeout
  144.         MOVEM.L (A7)+,D4/D5/A4
  145.         MOVE    #-1,(A3)+
  146.         RTS
  147.        ok:
  148.         MOVEM.L (A7)+,D4/D5/A4
  149.         CLR     (A3)+
  150.     END
  151.   END strout;
  152.   (*$L=*)
  153.  
  154. PROCEDURE flush0 (a:LONGWORD): INTEGER;
  155.   (*$L-*)
  156.   BEGIN
  157.     ASSEMBLER
  158.         SUBQ.L  #4,A3
  159.         CLR     (A3)+
  160.     END
  161.   END flush0;
  162.   (*$L=*)
  163.  
  164. BEGIN
  165.   CloseFile:= dummyClose;
  166.   HandleError:= dummyHdlErr;
  167.   (* Wird automatisch gelöscht:
  168.     FOR c:= con TO ext3 DO
  169.       UnitDriver [c].valid:= FALSE
  170.     END
  171.   *)
  172.   WITH UnitDriver [con] DO
  173.     valid:= TRUE;
  174.     name:= 'CON:';
  175.     input:= TRUE;
  176.     output:= TRUE;
  177.     initHdl:= CAST (LONGWORD, 2L);
  178.     flush:= flush0;
  179.     open:= open0;
  180.     close:= close0;
  181.     rdData:= din;
  182.     wrData:= dout;
  183.     (*extRS:= FALSE;*)
  184.     wrStr:= strout;
  185.     rdChr:= chin
  186.   END;
  187.   WITH UnitDriver [prn] DO
  188.     valid:= TRUE;
  189.     name:= 'PRN:';
  190.     output:= TRUE;
  191.     initHdl:= CAST (LONGWORD, 0L);
  192.     flush:= flush0;
  193.     open:= open0;
  194.     close:= close0;
  195.     wrData:= dout;
  196.     wrStr:= strout;
  197.   END;
  198.   WITH UnitDriver [aux] DO
  199.     valid:= TRUE;
  200.     name:= 'AUX:';
  201.     input:= TRUE;
  202.     output:= TRUE;
  203.     initHdl:= CAST (LONGWORD, 1L);
  204.     flush:= flush0;
  205.     open:= open0;
  206.     close:= close0;
  207.     rdData:= din;
  208.     wrData:= dout;
  209.     (*extRS:= FALSE;*)
  210.     wrStr:= strout;
  211.     rdChr:= chin
  212.   END;
  213.   WITH UnitDriver [kbd] DO
  214.     valid:= TRUE;
  215.     name:= 'KBD:';
  216.     input:= TRUE;
  217.     initHdl:= CAST (LONGWORD, 2L);
  218.     open:= open0;
  219.     close:= close0;
  220.     rdData:= din;
  221.     (*extRS:= FALSE;*)
  222.     rdChr:= chin
  223.   END;
  224.   WITH UnitDriver [midi] DO
  225.     valid:= TRUE;
  226.     name:= 'MIDI:';
  227.     input:= TRUE;
  228.     output:= TRUE;
  229.     initHdl:= CAST (LONGWORD, 4L);
  230.     flush:= flush0;
  231.     open:= open0;
  232.     close:= close0;
  233.     rdData:= din;
  234.     wrData:= dout;
  235.     (*extRS:= FALSE;*)
  236.     wrStr:= strout;
  237.     rdChr:= chin
  238.   END;
  239. END FileBase.
  240.  
  241.